/*
    This file is part of the substandard lisp implementation of Standard Lisp
    Copyright (C) 2011 Nicky Nickell

    substandard lisp is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

/*
    builtins related to dotted-pairs as defined in section 3.2 of the 
    The Standard Lisp Report
*/

function std_car(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car;
}
builtins['car'] = new builtin_function(std_car, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr;
}
builtins['cdr'] = new builtin_function(std_cdr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr;
}
builtins['cddr'] = new builtin_function(std_cddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr;
}
builtins['cdar'] = new builtin_function(std_cdar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car;
}
builtins['cadr'] = new builtin_function(std_cadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car;
}
builtins['caar'] = new builtin_function(std_caar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.cdr;
}
builtins['cdddr'] = new builtin_function(std_cddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cddar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.cdr;
}
builtins['cddar'] = new builtin_function(std_cddar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.cdr;
}
builtins['cdadr'] = new builtin_function(std_cdadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.cdr;
}
builtins['cdaar'] = new builtin_function(std_cdaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.car;
}
builtins['caddr'] = new builtin_function(std_caddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cadar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.car;
}
builtins['cadar'] = new builtin_function(std_cadar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.car;
}
builtins['caadr'] = new builtin_function(std_caadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.car;
}
builtins['caaar'] = new builtin_function(std_caaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cddddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.cdr.cdr;
}
builtins['cddddr'] = new builtin_function(std_cddddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdddar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.cdr.cdr;
}
builtins['cdddar'] = new builtin_function(std_cdddar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cddadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.cdr.cdr;
}
builtins['cddadr'] = new builtin_function(std_cddadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cddaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.cdr.cdr;
}
builtins['cddaar'] = new builtin_function(std_cddaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdaddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.car.cdr;
}
builtins['cdaddr'] = new builtin_function(std_cdaddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdadar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.car.cdr;
}
builtins['cdadar'] = new builtin_function(std_cdadar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdaadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.car.cdr;
}
builtins['cdaadr'] = new builtin_function(std_cdaadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cdaaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.car.cdr;
}
builtins['cdaaar'] = new builtin_function(std_cdaaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cadddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.cdr.car;
}
builtins['cadddr'] = new builtin_function(std_cadddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caddar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.cdr.car;
}
builtins['caddar'] = new builtin_function(std_caddar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cadadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.cdr.car;
}
builtins['cadadr'] = new builtin_function(std_cadadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_cadaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.cdr.car;
}
builtins['cadaar'] = new builtin_function(std_cadaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caaddr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.cdr.car.car;
}
builtins['caaddr'] = new builtin_function(std_caaddr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caadar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.cdr.car.car;
}
builtins['caadar'] = new builtin_function(std_caadar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caaadr(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.cdr.car.car.car;
}
builtins['caaadr'] = new builtin_function(std_caaadr, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);

function std_caaaar(a, env) {
  var u = a[0];

  if (u == T) {
    throw new Error('***** T is not a list');
  }

  return u.car.car.car.car;
}
builtins['caaaar'] = new builtin_function(std_caaaar, 1, false, [TYPE_PAIR | TYPE_BOOLEAN], FTYPE_EXPR);


function std_cons(a, env) {
  var u = a[0];
  var v = a[1];

  return new lisp_pair(u, v);
}
builtins['cons'] = new builtin_function(std_cons, 2, false, [CLASS_ANY, CLASS_ANY], FTYPE_EXPR);

function std_list(a, env) {
  var u = a[0];

  var head = new lisp_pair(evaluate(u[0], env), NIL);
  var ptr = head;

  for (var i = 1; i < u.length; i++) {
    ptr.cdr = new lisp_pair(evaluate(u[i], env), NIL);
    ptr = ptr.cdr;
  }

  return head;
}
builtins['list'] = new builtin_function(std_list, 0, true, [CLASS_ANY], FTYPE_FEXPR);

function std_rplaca(a, env) {
  var u = a[0];
  var v = a[1];

  u.car = v;
  return u;
}
builtins['rplaca'] = new builtin_function(std_rplaca, 2, false, [TYPE_PAIR, CLASS_ANY], FTYPE_EXPR);

function std_rplacd(a, env) {
  var u = a[0];
  var v = a[1];

  u.cdr = v;
  return u;
}
builtins['rplacd'] = new builtin_function(std_rplacd, 2, false, [TYPE_PAIR, CLASS_ANY], FTYPE_EXPR);
